Compare Gesture

This document is a first attempt to quantitatively compare gestures made using the Gepeto app with their corresponding reference gestures. Following the model of d’allessandro et al 2011, we use Pearson’s correlation and Root Mean Square Error (RMSE) are computed. Results are presented along with plots of the gesture scaled to and overlaid with its reference. Audio of both are also included.

The original paper weighed the correlation and RMSE with the signal power. For simplicity, I am not doing that for now, but results still seem ok. The original paper also used dynamic time warping to modify signals of uneven lengths. I am just doing a linear scaling, which does not warp the rhythm of the signal. It is important to retain the actual rhythm of the gesture because the correct pronunciation of the corpus phrases depend on correct rhythm.

Right now, I’m only comparing the output f0 curves without taking into consideration where the syllables are. For some gestures that sound distorted yet still have high scores, taking rhythm into account should yield more accurate scores.

1 Helper functions for evenly spaced curve

Both correlation and RMSE take two time series as input. Therefore, it is necessary to convert both the reference pitch curve and gestures from the Gepeto interface into time series data.

The following is a function that takes a tibble with unevenly spaced points of frequency data (on a 0 to 1 scale) and converts it to a tibble with a certain number of evenly spaced points whose values are interpolated from the original data.

2 Loading reference pitch curves

References contain information about the stylized pitch curve of a phrase. The stylization is done by Prosogram, an extension to Praat based on a perceptual model detailed by d’Allessandro and Mertens 1995. The stylization is originally generated as PitchTier files by Prosogram but are converted to JSON by Script 3: pitchtierToJSON.

The code below loads all the available reference files but only looks at the first one as a test.

2.1 Loading all phrases

Now let’s do the same thing to all the reference files

# Original data for each reference, in terms of:
# percent : percentage time (i.e. scrub)
# f : frequency in ST with 130 hz reference
ref_originals <- lapply(ref_filenames, function(elt) {
  result <- fromJSON(paste0(path,"prosogram_pt/", elt)) %>% as_tibble() %>% 
            # To avoid confusion, create new column called percent
            mutate(percent = scrub) %>% select(percent, f)
})

# Interpolated time series data of just the f values
ref_tss <- lapply(ref_originals, function(elt) {
  ref_interp<-get_interpolated_data(elt, num_samples)
  ref_interp$value
})

# A vector with just the names of the phrases (w/o .json extension)
ref_phrases <- do.call("rbind", lapply(ref_filenames, function(elt) {
  str_split(elt, '.json')[[1]][1]
}))[,1]

# Returns the reference time series f values given the phrase name
get_ref_ts <- function(phrase_name) {
  index <- match(phrase_name, ref_phrases)
  if (is.na(index)) { return(NULL) }
  return(ref_tss[[index]])
}

3 Loading gestures

The gestures are collected from non-native speakers enrolled in a class on French rhythm and intonation. First, just load and plot one gesture as a test.

The resulting gesture is plotted with its reference overlaid. In this analysis, the phonemes of the gesture are not aligned with those of the reference. It’s

3.1 Loading all gestures

Now, convert all the gestures into time series.

# Original data for each gesture, in terms of:
# percent : percentage time (i.e. scrub)
# f : frequency in ST with 130 hz reference
gest_originals <- lapply(gest_filenames, function(elt) {
  result <- fromJSON(paste0(path, elt)) %>% as_tibble() %>% 
    # NOTE THIS EXTRA STEP      
    prep_gest()
})

# Interpolated time series data of just the f values
gest_tss <- lapply(gest_originals, function(elt) {
  gest_interp<-get_interpolated_data(elt, num_samples)
  gest_interp$value
})

# Returns the gesture time series f values given the phrase name
get_gest_ts <- function(gest_name) {
  index <- match(gest_name, gests)
  if (is.na(index)) { return(NULL) }
  return(gest_tss[[index]])
}

4 Testing comparison functions

Now we are ready to quantitatively compare a gesture and its reference. One method is Pearson’s Correlation, which check’s the similarity between the two curves. A value of 1 means identical curves. Note that the mean is subtracted from each curve, so larger gaps between the curves should not decrease the correlation value.

\(r = \frac{{}\sum_{i=1}^{n} (x_i - \overline{x})(y_i - \overline{y})} {\sqrt{\sum_{i=1}^{n} (x_i - \overline{x})^2(y_i - \overline{y})^2}}\)

Another method is Root Mean Square Error (RMS), which meansures the dissiminlarity between the two curves. The higher the number means there is more difference.

$ RMS = $

In the 2011 paper evaluating chironomy, both of these measures are weighed by the intensity of the reference audio. For now I’m leaving that weighting out.

cor(ref_ts, gest_ts,  method = "pearson")

[1] 0.493454

rmse <- function(a, b) {
  return(sqrt(sum( ((a-mean(a)) - (b-mean(b))) ^2 )))
}

rmse(ref_ts, gest_ts)

[1] 42.37105

4.1 Calculating comparison functions for all gestures

# A vector with just the names of the phrases (w/o .json extension)
gests <- do.call("rbind", lapply(gest_filenames, function(elt) {
  str_split(elt, '.gest')[[1]][1]
}))[,1]

# Just the name of subjects
gest_subjects <- do.call("rbind", lapply(gests, function(elt) {
  tail(str_split(elt, '-')[[1]], 1)
}))[,1]
# Just the name of phrases
gest_phrases <- do.call("rbind", lapply(gests, function(elt) {
  str_split(elt, '-')[[1]]
}))[,1]

# Extract the reference phrase from the whole gesture name
get_ref_name <- function(gest_name) {
  return(str_split(gest_name, '-')[[1]][1])
}

# Compute the correlatoin and rms given the entire gesture name
get_corr <- function(gest_name) {
  ref_ts <- get_ref_ts(get_ref_name(gest_name))
  gest_ts <- get_gest_ts(gest_name)
  return(cor(ref_ts, gest_ts, method="pearson"))
}

get_rms <- function(gest_name) {
  ref_ts <- get_ref_ts(get_ref_name(gest_name))
  gest_ts <- get_gest_ts(gest_name)
  return(rmse(ref_ts, gest_ts))
}

corr_all <- do.call("rbind", lapply(gests, function(elt) {
  get_corr(elt)
}))[,1]

rmse_all <- do.call("rbind", lapply(gests, function(elt) {
  get_rms(elt)
}))[,1]

# Combine the above vectors into a tibble
gest_tibble <- tibble(gest=gests, corr=corr_all, rmse=rmse_all)
print(as.matrix(gest_tibble), quote = FALSE)

      gest                                       corr        rmse    
 [1,] 1_Il_nait_tres_premature-a_c                0.49345403 42.37105
 [2,] 1_Il_nait_tres_premature-b_m                0.77186565 32.54695
 [3,] 10_jean_saigne_beaucoup-a_m                -0.37965230 36.67639
 [4,] 10bis_jenseigne_beaucoup-l1                 0.41159391 23.43155
 [5,] 10bis_jenseigne_beaucoup-l2                 0.77562055 17.50671
 [6,] 13_la_belle_ferme_le_voile-c1               0.76059930 29.17405
 [7,] 13_la_belle_ferme_le_voile-c2               0.93557979 16.69488
 [8,] 13bis_la_belle_ferme__le_voile-g1           0.85223163 26.02876
 [9,] 13bis_la_belle_ferme__le_voile-g2           0.92521216 15.35320
[10,] 1bis_Il_naitrait_premature-a_y             -0.26542755 43.33155
[11,] 1bis_Il_naitrait_premature-b_g              0.85193229 25.67243
[12,] 2_tu_parais_tres_soucieux-a_c               0.73495035 32.21343
[13,] 2_tu_parais_tres_soucieux-b_s               0.91186830 21.97501
[14,] 20_jean_pierre_et_jacques-s1               -0.05181063 54.16585
[15,] 20_jean_pierre_et_jacques-s2                0.54297527 39.86701
[16,] 20_jean_pierre_et_jacques-s3                0.59164138 37.16551
[17,] 20bis_jeanpierre_et_jacques-y1             -0.06930822 35.38395
[18,] 20bis_jeanpierre_et_jacques-y2              0.74905564 23.81674
[19,] 27_la_bonne__cuisine_avec_des_navets-v1     0.41059865 43.34267
[20,] 27_la_bonne__cuisine_avec_des_navets-v2     0.79152527 30.19718
[21,] 27_la_bonne__cuisine_avec_des_navets-v3     0.61458470 40.98867
[22,] 27bis_la_bonne_cuisine__avec_des_navets-m1  0.82886586 24.10916
[23,] 27bis_la_bonne_cuisine__avec_des_navets-m2  0.83839011 27.22726
[24,] 27bis_la_bonne_cuisine__avec_des_navets-m3  0.76041101 28.90396
[25,] 2bis_tu_paraitrais_soucieux-a_g             0.68682280 24.70003
[26,] 2bis_tu_paraitrais_soucieux-b_y             0.38597443 31.00174

4.2 Plotting

Let see if our numbers make sense. In Christophe’s previous evaluation, they primarily looked at the correlation value and only looked at the RMS if the correlation was the same for two stimuli.

plot_gest_and_ref <- function(gest_name) {
  ref_phrase <- get_ref_name(gest_name)
  ref_ts <- get_ref_ts(ref_phrase)
  gest_ts <- get_gest_ts(gest_name)
  
  row <- filter(gest_tibble, gest==gest_name)
  corr <- round(row$corr, 4)
  rmse <- round(row$rmse, 4)
  
  my_data <- tibble(gest=gest_ts, ref=ref_ts, percent=seq(0, 1, length.out=num_samples))
  
  my_plot <- ggplot(data=my_data, aes(x=percent, y=gest, color="gesture")) +
    scale_color_discrete(name = "Data source") +
    geom_point(size=0.5) +
    geom_point(data=my_data, aes(x=percent, y=ref, color="reference"), size=0.5) +
    labs(title=paste(gest_name, "with its reference"), 
            subtitle=paste("Corr:", corr, "RMSE:", rmse),
            y="frequency (semitones from 130hz)",
            x="percent time")
  return(my_plot)
}

# Plot everything and store plots in a list
plots_all<-lapply(gests, plot_gest_and_ref)

Now, let’s divide the gestures by score ranges and plot them. There are some exceptions for the mid values, but in general, the highest scoring gestures are the most accurate and the lowest scoring the least accurate.

4.2.1 Highest scoring gestures (> 0.9)

Gesture Original

A visual guide was displayed for this trial.

Gesture Original

A visual guide was displayed for this trial.

Gesture Original

A visual guide was not displayed for this trial. This one is unmistakably pronouncing the correct phrase, but it sounds like it has a bit of an accent.

4.2.2 Highish scores (.7 to .9)

plots_all[[2]]

Gesture Original

Sounds correct to me.

plots_all[[5]]

Gesture Original

Sounds correct to me.

plots_all[[11]]

Gesture Original

Sounds correct but a bit odd.

plots_all[[12]]

Gesture Original

Sounds correct but the rhythm is quite off

plots_all[[18]]

Gesture Original

Sounds correct to me.

plots_all[[20]]

Gesture Original

Sounds correct to me.

plots_all[[23]]

Gesture Original

Sounds a bit weird with rhythm in the end.

plots_all[[24]]

Gesture Original

Sounds correct to me.

4.2.3 Midish scores (.5 to .7)

plots_all[[15]]

Gesture Original

With visual guide. Sounds correct to me.

plots_all[[16]]

Gesture Original

With visual guide. Sounds correct.

plots_all[[21]]

Gesture Original

With visual guide. Sounds a bit ambiguous.

plots_all[[25]]

Gesture Original

Without visual guide. Most likely correct but could be a bit ambiguous.

4.2.4 Lowish scores (.3 to .5)

plots_all[[1]]

Gesture Original

Without visual guide. Sounds correct to me.

plots_all[[4]]

Gesture Original

Without visual guide. Could be heard as correct phrase but ambiguous.

plots_all[[19]]

Gesture Original

Without visual guide. Sounds very ambiguous.

plots_all[[26]]

Gesture Original

Without visual guide. Sounds incorrect or ambiguous.

4.2.5 Lowest scores(< 0)

plots_all[[3]]

Gesture Original

A visual guide was not displayed for this trial. The gesture sounds like the other meaning of the phrase.

plots_all[[10]]

Gesture Original

A visual guide was not displayed for this trial. I think this would still be heard as the correct phrase, but its intonation deviates enormously from the target.

plots_all[[17]]

Gesture Original

A visual guide was not displayed for this trial. The gesture sounds quite ambiguous. Could sometimes get heard incorrectly.

plots_all[[14]]

Gesture Original

A visual guide was not displayed for this trial. Despite the low correlation score, I think this phrase would probably be heard correctly.